home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-03-01 | 55.2 KB | 2,072 lines | [ TEXT/PJMM]
unit Edit; {Editing routines used by NIH Image} interface uses Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows, Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes, globals, Utilities, Graphics, Camera, analysis, file1, filters, stacks, Lut, Text, math; procedure FlipOrRotate (DoWhat: FlipRotateType); procedure RotateToNewWindow (DoWhat: FlipRotateType); procedure Rotate (DoWhat: FlipRotateType); procedure DoCopy; procedure DoCut; procedure DoPaste; procedure DoClear; procedure ShowClipboard; procedure DoObject (obj: ObjectType; event: EventRecord); procedure DoSprayCan; procedure DoBrush (event: EventRecord); procedure DoText (loc: point); procedure SetSprayCanSize; procedure SetBrushSize; procedure SetLineWidth; procedure UpdateEditMenu; procedure ConverToSystemClipboard; procedure ZoomOut; procedure ZoomIn (event: EventRecord); procedure Scroll (event: EventRecord); procedure DoFill (event: EventRecord); procedure DoGrow (WhichWindow: WindowPtr; event: EventRecord); procedure DrawCharacter (ch: char); procedure ConvertFromSystemClipboard; procedure SetupOperation (item: integer); procedure PastePicture; procedure DoUndo; procedure FindWhatToCopy; procedure CopyResults; implementation procedure PivotSelection (var SelectionRect: rect; WindowRect: rect); var OldWidth, NewWidth, OldHeight, NewHeight, hCenter, vCenter, NewLeft, NewTop: integer; begin with SelectionRect do begin OldWidth := right - left; OldHeight := bottom - top; hCenter := left + OldWidth div 2; vCenter := top + OldHeight div 2; end; NewWidth := OldHeight; NewHeight := OldWidth; NewLeft := hCenter - NewWidth div 2; NewTop := vCenter - NewHeight div 2; with WindowRect do begin if (NewLeft + NewWidth) > right then NewLeft := right - NewWidth; if (NewTop + NewHeight) > bottom then NewTop := bottom - NewHeight; if NewLeft < 0 then NewLeft := 0; if NewTop < 0 then NewTop := 0; end; with SelectionRect do begin left := NewLeft; top := NewTop; right := NewLeft + NewWidth; bottom := NewTop + NewHeight; end; end; procedure FlipLine (var LineBuf: LineType; width: integer); var TempLine: LineType; i, WidthLessOne: integer; begin TempLine := LineBuf; WidthLessOne := width - 1; for i := 0 to width - 1 do LineBuf[i] := TempLine[WidthLessOne - i]; end; procedure ScreenToOffscreenRect (var r: rect); var p1, p2: point; begin with r do begin p1.h := left; p1.v := top; p2.h := right; p2.v := bottom; ScreenToOffscreen(p1); ScreenToOffscreen(p2); Pt2Rect(p1, p2, r); end; end; procedure FlipOrRotate (DoWhat: FlipRotateType); var SaveInfo: InfoPtr; width, height, hDst, vSrc, vDst, hSrc, i, inc: integer; LineBuf: LineType; srect, drect, MaskRect: rect; AutoSelectAll: boolean; SaveRow:integer; NextUpdate: LongInt; begin if NotRectangular or NotInBounds or NoUndo then exit(FlipOrRotate); AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); if TooWide then exit(FlipOrRotate); ShowWatch; SetupUndoFromClip; SetupUndo; if (DoWhat = RotateLeft) or (DoWhat = RotateRight) then WhatToUndo := UndoRotate else WhatToUndo := UndoFlip; SetupUndoInfoRec; SaveInfo := Info; srect := info^.RoiRect; case DoWhat of RotateLeft, RotateRight: with srect do begin if OptionKeyWasDown then DoOperation(EraseOp); drect := srect; with info^ do begin PivotSelection(drect, PicRect); MaskRect := drect; RoiRect := drect; RectRgn(roiRgn, RoiRect); end; width := right - left; if DoWhat = RotateLeft then begin hDst := drect.left; inc := 1 end else begin hDst := drect.right - 1; inc := -1 end; SaveRow:=top; NextUpdate:=TickCount+6; {10/sec} for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); if DoWhat = RotateLeft then FlipLine(LineBuf, width); Info := SaveInfo; PutColumn(hDst, drect.top, width, LineBuf); hDst := hDst + inc; if TickCount>=NextUpdate then begin SetRect(MaskRect, left, SaveRow, left+width, vSrc + 1); UpdateScreen(MaskRect); SaveRow:=vSrc+1; NextUpdate:=TickCount+6; ShowAnimatedWatch; end; end; SetRect(MaskRect, left, SaveRow, left+width, bottom); UpdateScreen(MaskRect); end; FlipVertical: with srect do begin width := right - left; vDst := bottom; for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); Info := SaveInfo; vDst := vDst - 1; PutLine(left, vDst, width, LineBuf); end; end; FlipHorizontal: with srect do begin width := right - left; SaveRow:=top; NextUpdate:=TickCount+6; {10/sec} for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); FlipLine(LineBuf, width); Info := SaveInfo; PutLine(left, vSrc, width, LineBuf); if TickCount>=NextUpdate then begin SetRect(MaskRect, left, SaveRow, left+width, vSrc + 1); UpdateScreen(MaskRect); SaveRow:=vSrc+1; NextUpdate:=TickCount+6; ShowAnimatedWatch; end; end; SetRect(MaskRect, left, SaveRow, left+width, bottom); UpdateScreen(MaskRect); end; end; {case} Info := SaveInfo; Info^.changes := true; SetupRoiRect; if AutoSelectAll then KillRoi; end; procedure RotateToNewWindow (DoWhat: FlipRotateType); var SrcInfo, DstInfo: InfoPtr; Srcwidth, DstWidth, DstHeight, hDst, vSrc, vDst, hSrc, i, inc, ignore: integer; LineBuf: LineType; SourceRect, DstRect, MaskRect: rect; AutoSelectAll, isStack: boolean; SaveCol:integer; NextUpdate: LongInt; begin if NotRectangular or NotInBounds then exit(RotateToNewWindow); AutoSelectAll := not Info^.RoiShowing; isStack := info^.StackInfo <> nil; if AutoSelectAll then SelectAll(true); if TooWide then exit(RotateToNewWindow); ShowWatch; SrcInfo := info; with info^, info^.RoiRect do begin SourceRect := RoiRect; SrcWidth := right - left; DstWidth := bottom - top; DstHeight := right - left; if not NewPicWindow(title, DstWidth, DstHeight) then begin KillRoi; AbortMacro; exit(RotateToNewWindow) end; DstInfo := info; DstRect := info^.PicRect; end; if DoWhat = RotateLeft then begin hDst := 0; inc := 1 end else begin hDst := DstWidth - 1; inc := -1 end; with SourceRect do begin SaveCol:=hDst; NextUpdate:=TickCount+6; {10/sec} for vSrc := top to bottom - 1 do begin Info := SrcInfo; GetLine(left, vSrc, SrcWidth, LineBuf); if DoWhat = RotateLeft then FlipLine(LineBuf, SrcWidth); Info := DstInfo; PutColumn(hDst, 0, SrcWidth, LineBuf); if TickCount>=NextUpdate then begin if DoWhat=RotateLeft then SetRect(MaskRect, SaveCol, 0, hDst+1, SrcWidth) else SetRect(MaskRect, hDst, 0, SaveCol+1, SrcWidth); UpdateScreen(MaskRect); SaveCol:=hDst+1; NextUpdate:=TickCount+6; ShowAnimatedWatch; end; hDst := hDst + inc; end; {for} if DoWhat=RotateLeft then SetRect(MaskRect, SaveCol, 0, dstWidth, SrcWidth) else SetRect(MaskRect, 0, 0, SaveCol+1, SrcWidth); UpdateScreen(MaskRect); end; {with} info^.changes := true; if AutoSelectAll and not isStack then with SrcInfo^ do begin Changes := false; ignore := CloseAWindow(wptr); info := DstInfo; end; end; procedure Rotate; {(DoWhat: FlipRotateType)} const NewWindowID = 3; var mylog: DialogPtr; item: integer; NewWindow: boolean; begin with info^, info^.RoiRect do if RoiShowing then NewWindow := ((right - left) > PicRect.bottom) or ((bottom - top) > PicRect.right) else begin RotateToNewWindow(DoWhat); exit(Rotate); end; InitCursor; mylog := GetNewDialog(120, nil, pointer(-1)); SetDlogItem(mylog, NewWindowID, ord(NewWindow)); OutlineButton(MyLog, ok, 16); repeat if item = NewWindowID then begin NewWindow := not NewWindow; SetDlogItem(mylog, NewWindowID, ord(NewWindow)); end; ModalDialog(nil, item); until (item = ok) or (item = cancel); DisposeDialog(mylog); if item = cancel then exit(Rotate); if NewWindow then RotateToNewWindow(DoWhat) else FlipOrRotate(DoWhat); end; function CopyImage: boolean; var err, width, EvenWidth, height, size: LongInt; line: integer; ClipXOffset, ClipYOffset: integer; SavePort: GrafPtr; SaveGDevice: GDHandle; begin if OpPending then begin KillRoi; RestoreRoi; end; with info^, info^.RoiRect do begin if (RoiType = RectRoi) and (PictureType = FrameGrabberType) then begin {We can't offset an roi copied from Camera window or "live" paste won't work} ClipXOffset := 0; ClipYOffset := 0; width := picRect.right; height := picRect.bottom; end else begin ClipXOffset := left; ClipYOffset := top; width := right - left; height := bottom - top; end; if odd(width) then EvenWidth := width + 1 else EvenWidth := width; size := EvenWidth * height; if size > ClipBufSize then begin PutError(StringOf('This ',size div 1024:1,'K selection is larger than the ',ClipBufSize div 1024:1,'K Clipboard buffer.')); WhatsOnClip := NothingOnClip; AbortMacro; CopyImage := false; exit(CopyImage) end; end; with ClipBufInfo^ do begin PixelsPerLine := width; BytesPerRow := EvenWidth; nLines := height; RoiRect := info^.RoiRect; OffsetRect(RoiRect, -ClipXOffset, -ClipYOffset); roiType := Info^.roiType; PicRect := RoiRect; with osPort^.portPixMap^^ do begin RowBytes := BitOr(BytesPerRow, $8000); bounds := PicRect; end; with osPort^ do begin PortRect := PicRect; RectRgn(visRgn, PicRect); end; if RoiType = RectRoi then begin if info^.PictureType = FrameGrabberType then WhatsOnClip := CameraPic else WhatsOnClip := RectPic end else WhatsOnClip := NonRectPic; SaveGDevice := GetGDevice; SetGDevice(osGDevice); GetPort(SavePort); SetPort(GrafPtr(osPort)); CopyRgn(info^.roiRgn, roiRgn); OffsetRgn(roiRgn, -ClipXOffset, -ClipYOffset); ctable := info^.ctable; pmForeColor(BlackIndex); pmBackColor(WhiteIndex); CopyBits(BitMapHandle(Info^.osPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, Info^.RoiRect, RoiRect, SrcCopy, nil); pmForeColor(ForegroundIndex); pmBackColor(BackgroundIndex); SetPort(SavePort); SetGDevice(SaveGDevice); end; {with} CopyImage := true; end; procedure CopyWindow; var tPort: GrafPtr; WindowSize: LongInt; WindowRect: rect; WhichWindow: WindowPtr; kind, ignore: integer; HidingPasteControl: boolean; SaveGDevice: GDHandle;i:integer; begin WhichWindow := FrontWindow; if WhichWindow = nil then exit(CopyWindow); WindowRect := WhichWindow^.PortRect; kind := WindowPeek(WhichWindow)^.WindowKind; HidingPasteControl := false; with WindowRect do begin WindowSize := right; WindowSize := WindowSize * bottom; end; if kind = LUTKind then WindowRect.bottom := 256; case kind of ProfilePlotKind: begin ConvertPlotToText; ClipTextInBuffer := true; end; CalibrationPlotKind: begin ConvertCalibrationCurveToText; ClipTextInBuffer := true; end; HistoKind, LUTKind, MapKind, ToolKind: begin if PasteControl <> nil then begin ignore := CloseAWindow(PasteControl); HidingPasteControl := true; end; case kind of HistoKind: begin ConvertHistoToText; ClipTextInBuffer := true; DrawHistogram; end; MapKind: DrawMap; LUTKind: DrawLUT; ToolKind: DrawTools; end; {case} end; otherwise end; {case} if NoUndo then begin WhatsOnClip := NothingOnClip; exit(CopyWindow) end; ClipboardConverted := false; with ClipBufInfo^ do begin RoiType := RectRoi; RoiRect := WindowRect; RectRgn(roiRgn, RoiRect); PicRect := WindowRect; PixelsPerLine := WindowRect.right; BytesPerRow := PixelsPerLine; if odd(BytesPerRow) then BytesPerRow := BytesPerRow + 1; nLines := WindowRect.bottom; with osPort^.portPixMap^^ do begin RowBytes := BitOr(BytesPerRow, $8000); bounds := WindowRect; end; with osPort^ do begin PortRect := PicRect; RectRgn(visRgn, PicRect); SetRectRgn(ClipRgn, 0, 0, 30000, 30000); end; WhatsOnClip := RectPic; SaveGDevice := GetGDevice; SetGDevice(osGDevice); GetPort(tPort); SetPort(GrafPtr(osPort)); RGBForeColor(BlackRGB); RGBBackColor(WhiteRGB); if (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) then begin EraseRect(osPort^.portRect); DrawPlot end else CopyBits(WhichWindow^.PortBits, BitMapHandle(osPort^.portPixMap)^^, WindowRect, WindowRect, SrcCopy, nil); SetPort(tPort); SetGDevice(SaveGDevice); end; {with} if HidingPasteControl then ShowPasteControl; end; procedure CopyResults; var err: OSErr; begin CopyResultsToBuffer(1, mCount, ShowHeadings); UnsavedResults := false; err := ZeroScrap; if err = NoErr then begin err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP)); WhatsOnClip := NothingOnClip; {The text is on the System Scrap} end; end; procedure DoCopy; var err: OSErr; begin err := ZeroScrap; OldScrapCount := GetScrapCount; case WhatToCopy of CopyColor: DoCopyColor; CopySelection: begin if not CopyImage then exit(DoCopy); ClipTextInBuffer := false; ClipboardConverted := false; end; CopyHistogram, CopyPlot, CopyCalibrationPlot, CopyCLUT, CopyGrayMap, CopyTools: CopyWindow; CopyMeasurements: CopyResults; CopyText: DoTextCopy; otherwise beep; end; end; procedure DoCut; begin DoCopy; DoClear; end; procedure CenterRect (inRect, outRect: rect; var ResultRect: rect); {Creates a new rectangle(ResultsRect) that is the same size as inRect, but centered within outRect.} var width, height, hcenter, vcenter: integer; begin with inRect do begin width := right - left; height := bottom - top; end; with outRect do begin hcenter := left + (right - left) div 2; vcenter := top + (bottom - top) div 2; end; with ResultRect do begin left := hcenter - width div 2; top := vcenter - height div 2; right := left + width; bottom := top + height; end; end; procedure PastePicture; var loc: point; SrcWidth, SrcHeight, DstHeight, DstWidth, dh, dv: integer; DestRect: rect; WindowNotResized: boolean; begin if LivePasteMode or (PasteTransferMode <> SrcCopy) then begin LivePasteMode := false; PasteTransferMode := SrcCopy; if PasteControl <> nil then DrawPasteControl end; with info^ do begin SetupUndo; WhatToUndo := UndoPaste; if RoiShowing then with RoiRect do {Pasting back into selection of same size?} if ((right - left) = (ClipBufInfo^.RoiRect.right - ClipBufInfo^.RoiRect.left)) and ((bottom - top) = (ClipBufInfo^.RoiRect.bottom - ClipBufInfo^.RoiRect.top)) and (ClipBufInfo^.RoiType = RoiType) then begin OpPending := true; CurrentOp := PasteOp; exit(PastePicture) end; with ClipBufInfo^.RoiRect do {Pasting into same size window?} if (PicRect.right = right - left) and (PicRect.bottom = (bottom - top)) and (ClipBufInfo^.RoiType = RectRoi) then begin SelectAll(true); WhatToUndo := UndoPaste; OpPending := true; CurrentOp := PasteOp; exit(PastePicture) end; if RoiShowing or (roiType <> NoRoi) then KillRoi; with ClipBufInfo^.RoiRect do begin SrcWidth := right - left; SrcHeight := bottom - top; end; with SrcRect do begin DstWidth := right - left; DstHeight := bottom - top; end; with initwrect do WindowNotResized := (DstWidth = (right - left)) and (DstHeight = (bottom - top)); if ((SrcWidth > DstWidth) or (SrcHeight > DstHeight)) and WindowNotResized then DestRect := PicRect else DestRect := SrcRect; CenterRect(ClipBufInfo^.RoiRect, DestRect, RoiRect); roiType := ClipBufInfo^.roiType; CopyRgn(ClipBufInfo^.roiRgn, roiRgn); dh := RoiRect.left - roiRgn^^.rgnbbox.left; dv := RoiRect.top - roiRgn^^.rgnbbox.top; OffsetRgn(roiRgn, dh, dv); RoiShowing := true; OpPending := true; CurrentOp := PasteOp; BinaryPic := false; end;{with} end; procedure ConvertFromSystemClipboard; {Converts system-wide clipboard to local clipboard.} var phandle: handle; offset, length, size, EvenWidth: LongInt; pframe: rect; width, height: LongInt; tPort: GrafPtr; ScrapInfo: ScrapStuffPtr; SaveGDevice: GDHandle; begin ScrapInfo := InfoScrap; if ScrapInfo^.ScrapSize <= 0 then exit(ConvertFromSystemClipboard); phandle := NewHandle(0); length := GetScrap(phandle, 'PICT', offset); if length > 0 then begin ShowWatch; pframe := PicHandle(phandle)^^.PicFrame; with pframe do begin width := right - left; if odd(width) then EvenWidth := width + 1 else EvenWidth := width; height := bottom - top; size := EvenWidth * height; if size > ClipBufSize then begin PutError(StringOf('The ', size div 1024:1,'K image on the system clipboard is too large to paste.')); DisposeHandle(phandle); exit(ConvertFromSystemClipboard) end; end; with ClipBufInfo^ do begin PixelsPerLine := width; nlines := height; SetRect(PicRect, 0, 0, width, height); RoiRect := PicRect; RoiType := RectRoi; SaveGDevice := GetGDevice; SetGDevice(osGDevice); GetPort(tPort); SetPort(GrafPtr(osPort)); RectRgn(roiRgn, RoiRect); BytesPerRow := EvenWidth; with osPort^.portPixMap^^ do begin RowBytes := BitOr(BytesPerRow, $8000); bounds := PicRect; end; with CGrafPtr(osPort)^ do begin PortRect := PicRect; RectRgn(visRgn, PicRect); SetRectRgn(ClipRgn, 0, 0, 30000, 30000); end; RGBForecolor(WhiteRGB); PaintRect(PicRect); DrawPicture(PicHandle(phandle), PicRect); SetPort(tPort); SetGDevice(SaveGDevice); end; {with} WhatsOnClip := ImportedPic; end else begin length := GetScrap(phandle, 'TEXT', offset); if (length > 0) and (length < MaxTextBufSize) then begin BlockMove(phandle^, ptr(TextBufP), length); TextBufSize := length; WhatsOnClip := TextOnClip; end; end; DisposeHandle(phandle); end; procedure PasteText; var nTextLines, LineWidth, MaxLineWidth, MaxRectWidth, MaxRectHeight: integer; LineStart, LineEnd, height, kind: integer; fwptr: WindowPtr; SaveGDevice: GDHandle; okay: boolean; begin fwptr := FrontWindow; if fwptr = nil then exit(PasteText); kind := WindowPeek(fwptr)^.WindowKind; if Kind = TextKind then begin DoTextPaste; exit(PasteText); end; if TextBufSize > 5000 then begin PutError('The maximum number of characters that can be pasted is 5000.'); exit(PasteText); end; if (Info = NoInfo) or NoUndo then exit(PasteText); with ClipBufInfo^ do begin SaveGDevice := GetGDevice; SetGDevice(osGDevice); SetPort(GrafPtr(osPort)); RGBForeColor(BlackRGB); RGBBackColor(WhiteRGB); TextFont(CurrentFontID); TextFace(CurrentStyle); TextSize(CurrentSize); end; with info^ do if (not RoiShowing) or (RoiShowing and (RoiType <> RectRoi)) then begin KillRoi; nTextLines := 1; MaxLineWidth := 10; LineStart := 1; LineEnd := 0; repeat LineEnd := LineEnd + 1; if TextBufP^[LineEnd] = cr then begin nTextLines := nTextLines + 1; LineWidth := TextWidth(ptr(TextBufP), LineStart - 1, LineEnd - LineStart); if LineWidth > MaxLineWidth then MaxLineWidth := LineWidth; LineStart := LineEnd; end; until LineEnd >= TextBufSize; if LineEnd > LineStart then begin LineWidth := TextWidth(ptr(TextBufP), LineStart - 1, LineEnd - LineStart); if LineWidth > MaxLineWidth then MaxLineWidth := LineWidth; end; height := nTextLines * CurrentSize + CurrentSize div 4; MaxRectHeight := (PicRect.bottom * 2) div 3; if height > MaxRectHeight then height := MaxRectHeight; MaxLineWidth := MaxLineWidth + CurrentSize div 2; MaxRectWidth := (PicRect.right * 2) div 3; if MaxLineWidth > MaxRectWidth then begin MaxLineWidth := MaxRectWidth; height := MaxRectHeight; end; with RoiRect do begin left := 0; top := 0; right := MaxLineWidth; bottom := height; end; RoiType := RectRoi; MakeRegion; end; okay := CopyImage; if okay then begin WhatsOnClip := TextOnClip; SetRectRgn(ClipBufInfo^.osPort^.ClipRgn, 0, 0, 30000, 30000); {Why is this needed?} TETextBox(ptr(TextBufP), TextBufSize, ClipBufInfo^.RoiRect, TextJust); PastePicture; end; SetGDevice(SaveGDevice); end; procedure DoPaste; var NewScrapCount: integer; begin if ((info = NoInfo) and (WhatsOnClip in [RectPic, NonRectPic, ImportedPic, CameraPic])) then begin if CurrentWindow <> TextKind then begin PutError('You must have an image window open to paste.'); exit(DoPaste); end else WhatsOnClip := NothingOnClip; end; RoiUpdateTime := 0; NewScrapCount := GetScrapCount; if NewScrapCount <> OldScrapCount then begin WhatsOnClip := NothingOnClip; OldScrapCount := NewScrapCount; end; case WhatsOnClip of aColor: PasteColor; RectPic, NonRectPic, ImportedPic, CameraPic: PastePicture; TextOnClip: PasteText; LivePic: WhatsOnClip := NothingOnClip; NothingOnClip: begin ConvertFromSystemClipboard; if (WhatsOnClip = ImportedPic) and (info <> NoInfo) then PastePicture else if WhatsOnClip = textOnClip then PasteText else beep; end; end; end; procedure DoClear; var fwptr: WindowPtr; kind: integer; begin fwptr := FrontWindow; if fwptr = nil then exit(DoClear); kind := WindowPeek(fwptr)^.WindowKind; if Kind = TextKind then begin DoTextClear; exit(DoClear); end; if not NoSelection then begin SetupUndo; WhatToUndo := UndoClear; CurrentOp := EraseOp; OpPending := true; RoiUpdateTime := 0; end; end; procedure ShowClipboard; var width, height, hstart, vstart, i, NewScrapCount: integer; okay:boolean; begin NewScrapCount := GetScrapCount; if NewScrapCount <> OldScrapCount then begin WhatsOnClip := NothingOnClip; OldScrapCount := NewScrapCount; end; if WhatsOnClip = NothingOnClip then ConvertFromSystemClipboard; if (WhatsOnClip = RectPic) or (WhatsOnClip = NonRectPic) or (WhatsOnClip = ImportedPic) or (WhatsOnClip = CameraPic) then with ClipBufinfo^.RoiRect do begin width := right - left; height := bottom - top; if NewPicWindow('Clipboard', width, height) then begin PastePicture; KillRoi; SetupUndo; info^.changes := false; end; end; if WhatsOnClip = TextOnClip then begin if MakeNewTextWindow('Clipboard', 400, 350) then DoTextPaste; end; end; function ScreenToPixmapH (hloc: integer): extended; begin with info^ do ScreenToPixmapH := SrcRect.left + hloc / magnification; end; function ScreenToPixmapV (vloc: integer): extended; begin with info^ do ScreenToPixmapV := SrcRect.top + vloc / magnification; end; procedure DoSelection (obj: ObjectType; start, finish: point); var tRect: rect; temp, StartH, StartV, FinishH, FinishV: integer; TempRgn: RgnHandle; begin WhatToUndo := NothingToUndo; Info^.RoiShowing := false; RoiUpdateTime := 0; if (start.h = finish.h) or (start.v = finish.v) then exit(DoSelection); if start.h > finish.h then begin temp := start.h; start.h := finish.h; finish.h := temp; end; if start.v > finish.v then begin temp := start.v; start.v := finish.v; finish.v := temp; end; StartH := round(ScreenToPixmapH(start.h)); StartV := round(ScreenToPixmapV(start.v)); FinishH := round(ScreenToPixmapH(finish.h)); FinishV := round(ScreenToPixmapV(finish.v)); SetRect(tRect, StartH, StartV, FinishH, FinishV); with info^ do begin RoiShowing := true; if SelectionMode <> NewSelection then TempRgn := NewRgn; OpenRgn; case obj of SelectionOval: begin FrameOval(tRect); roiType := OvalRoi; end; SelectionRect: begin FrameRect(tRect); roiType := RectRoi; end; end; if SelectionMode = NewSelection then CloseRgn(roiRgn) else begin CloseRgn(TempRgn); if RgnNotTooBig(roiRgn, TempRgn) then begin if SelectionMode = AddSelection then UnionRgn(roiRgn, TempRgn, roiRgn) else begin DiffRgn(roiRgn, TempRgn, roiRgn); UpdatePicWindow; end; end; DisposeRgn(TempRgn); if GetHandleSize(handle(roiRgn)) = 10 then roiType := RectRoi else roiType := FreehandRoi; nCoordinates := 0; end; RoiRect := roiRgn^^.rgnBBox; end;{with} measuring := false; end; procedure DoObject; {(obj: ObjectType; event: EventRecord)} var Start, Finish, ScreenStart, ScreenFinish, osStart, osFinish: point; r: rect; DeltaX, DeltaY, switch: integer; Constrain: boolean; StartH, StartV: extended; begin SetPort(info^.wptr); if obj = LineObj then DrawLabels('DX:', 'DY:', 'Length:') else DrawLabels('Width:', 'Height:', ''); start := event.where; StartH := ScreenToPixmapH(start.h); StartV := ScreenToPixmapV(start.v); osStart := start; ScreenToOffscreen(osStart); finish := start; osFinish := finish; ScreenToOffscreen(osFinish); PenNormal; PenMode(PatXor); PenSize(1, 1); while button do begin GetMouse(finish); with finish, Info^ do begin if h > wrect.right then h := wrect.right; if v > wrect.bottom then v := wrect.bottom; if h < 0 then h := 0; if v < 0 then v := 0; end; if ShiftKeyDown then begin DeltaX := finish.h - start.h; DeltaY := finish.v - start.v; if obj = lineObj then begin if abs(DeltaX) > abs(DeltaY) then finish.v := start.v else finish.h := start.h end else begin if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then switch := -1 else switch := 1; if abs(DeltaX) > abs(DeltaY) then finish.h := start.h + switch * DeltaY else finish.v := start.v + switch * DeltaX; end; end; osFinish := finish; ScreenToOffscreen(osfinish); case obj of LineObj: begin MoveTo(start.h, start.v); LineTo(finish.h, finish.v); ShowDxDy(abs(ScreenToPixMapH(finish.h) - StartH), abs(ScreenToPixMapV(finish.v) - StartV)); MoveTo(start.h, start.v); LineTo(finish.h, finish.v); end; Rectangle, SelectionRect: begin if obj = SelectionRect then begin PatIndex := (PatIndex + 1) mod 8; PenPat(AntPattern[PatIndex]); end; Pt2Rect(start, finish, r); FrameRect(r); Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1); Pt2Rect(start, finish, r); FrameRect(r); end; SelectionOval: begin PatIndex := (PatIndex + 1) mod 8; PenPat(AntPattern[PatIndex]); Pt2Rect(start, finish, r); FrameOval(r); Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1); Pt2Rect(start, finish, r); FrameOval(r); end; end; {case} end; {while button} if (obj = SelectionRect) or (obj = SelectionOval) then begin DoSelection(obj, start, finish); exit(DoObject); end; if (obj = LineObj) and ((CurrentTool = LineTool) or (CurrentTool = PlotTool)) then begin MoveTo(start.h, start.v); LineTo(finish.h, finish.v); with info^ do begin LX1 := StartH; LY1 := StartV; LX2 := ScreenToPixmapH(finish.h); LY2 := ScreenToPixmapV(finish.v); if LX1 > (PicRect.right - 1) then LX1 := PicRect.right - 1; if LY1 > (PicRect.bottom - 1) then LY1 := PicRect.bottom - 1; if LX1 < 0 then LX1 := 0; if LY1 < 0 then LY1 := 0; if LX2 > (PicRect.right - 1) then LX2 := PicRect.right - 1; if LY2 > (PicRect.bottom - 1) then LY2 := PicRect.bottom - 1; if LX2 < 0 then LX2 := 0; if LY2 < 0 then LY2 := 0; end; exit(DoObject); end; DrawObject(obj, start, finish); end; procedure DrawSprayCan (xcenter, ycenter: integer); var i, xoffset, yoffset, nDots: LongInt; begin nDots := SprayCanDiameter div 4; if nDots < 15 then nDots := 15; for i := 1 to nDots do begin repeat xoffset := random mod SprayCanRadius; yoffset := random mod SprayCanRadius; until xoffset * xoffset + yoffset * yoffset <= SprayCanRadius2; PutPixel(xcenter + xoffset, ycenter + yoffset, ForegroundIndex); end; end; procedure DoSprayCan; {Reference: "Spaying and Smudging", Dick Pountain, Byte, November 1987} var xcenter, ycenter, off: integer; MaskRect: rect; pt: point; SaveTicks:LongInt; begin info^.changes := true; off := SprayCanRadius; SaveTicks:=TickCount; repeat repeat until TickCount<>SaveTicks; {Update no more than 60 times per second} SaveTicks:=TickCount; GetMouse(pt); ScreenToOffscreen(pt); with MaskRect, pt do begin left := h - off; top := v - off; right := h + off; bottom := v + off; end; with pt do begin xcenter := h; ycenter := v end; DrawSprayCan(xcenter, ycenter); UpdateScreen(MaskRect); until not button; WhatToUndo := UndoEdit; end; procedure DoBrush; {(event: EventRecord)} var r, ScreenRect: rect; p1, p2, p2x, start: point; WhichWindow: WindowPtr; SaveLineWidth, SaveForegroundColor: integer; Constrained, MoreHorizontal, FirstTime: boolean; offset, width: integer; rWidth: double; begin SaveLineWidth := LineWidth; p1 := event.where; start := p1; if OptionKeyDown then begin case CurrentTool of Brush, Pencil: GetForegroundColor(event); Eraser: GetBackgroundColor(event); end; if (CurrentTool = Brush) or (CurrentTool = Eraser) then exit(DoBrush); end; case CurrentTool of Pencil: LineWidth := 1; Brush, Eraser: begin if CurrentTool = Brush then width := BrushWidth else width := 16; LineWidth := round(width / info^.magnification); if LineWidth < 1 then LineWidth := 1; end; end; with info^ do rWidth := (LineWidth - 1) * info^.magnification / 2.0; offset := round(rWidth * 1.00000001); {ppc-bug} if CurrentTool <> Pencil then with p1 do begin h := h - offset; v := v - offset end; Constrained := ShiftKeyDown; FirstTime := true; if CurrentTool = eraser then begin SaveForegroundColor := ForegroundIndex; SetForegroundColor(BackgroundIndex) end; repeat GetMouse(p2); if CurrentTool <> Pencil then with p2 do begin h := h - offset; v := v - offset end; if FirstTime then if not EqualPt(p1, p2) then begin MoreHorizontal := abs(p2.h - p1.h) >= abs(p2.v - p1.v); FirstTime := false; end; if Constrained then if MoreHorizontal then p2.v := p1.v else p2.h := p1.h; if CurrentTool = brush then DrawObject(BrushObj, p1, p2) else DrawObject(LineObj, p1, p2); p1 := p2; until not button; if CurrentTool = Eraser then SetForegroundColor(SaveForegroundColor); LineWidth := SaveLineWidth; WhatToUndo := UndoEdit; end; procedure DrawCharacter; {(ch: char)} var str: str255; begin if Info = NoInfo then begin beep; exit(DrawCharacter) end; if ch = cr then with InsertionPoint do begin h := TextStart.h; v := v + CurrentSize; SetupUndo; TextStr := ''; TextStart := InsertionPoint; exit(DrawCharacter) end; if ch = BackSpace then with InsertionPoint do begin if length(TextStr) > 0 then begin delete(TextStr, length(TextStr), 1); DisplayText(true); end; exit(DrawCharacter) end; str := ' '; {Needed for MPW} str[1] := ch; TextStr := Concat(TextStr, str); DisplayText(true); end; procedure DoText; {(loc: point)} {Handles text tool mouse clicks.} var value: extended; str: str255; isValue: boolean; begin if NoUndo then exit(DoText); ScreenToOffscreen(loc); with loc do begin InsertionPoint.h := h; InsertionPoint.v := v + 4; end; IsInsertionPoint := true; TextStart := InsertionPoint; TextStr := ''; if OptionKeyDown then with info^ do begin isValue := true; if (PreviousTool = LineTool) and (nLengths > 0) then value := plength^[mCount2] else if (PreviousTool = AngleTool) and (nAngles > 0) then value := orientation^[mCount2] else if mCount > 0 then if AreaM in Measurements then value := mArea^[mCount2] else if MeanM in Measurements then value := mean^[mCount2] else isValue := false; if isValue then begin RealToString(value, 1, precision, str); if mCount2 > 0 then mCount2 := mCount2 - 1; DrawTextString(str, TextStart, TextJust); end; end; WhatToUndo := UndoEdit; end; procedure DoFill (event: EventRecord); var loc: point; MaskBits: BitMap; BitMapSize: LongInt; tPort: GrafPtr; trect: rect; SaveGDevice: GDHandle; begin ShowWatch; loc := event.where; ScreenToOffscreen(loc); with info^ do begin tRect := PicRect; with tRect do if (right mod 16 <> 0) and not Has32BitQuickDraw then right := (right div 16) * 16 + 16; {Workaround for SeedCFill bug that results in garbage along right edge.} with MaskBits do begin RowBytes := PixelsPerLine div 8 + 1; if odd(RowBytes) then RowBytes := RowBytes + 1; bounds := tRect; BitMapSize := rowBytes * nLines; baseAddr := NewPtr(BitMapSize); if baseAddr = nil then begin beep; exit(DoFill) end; end; SaveGDevice := GetGDevice; SetGDevice(osGDevice); GetPort(tPort); SetPort(GrafPtr(osPort)); pmForeColor(ForegroundIndex); SeedCFill(BitMapHandle(osPort^.PortPixMap)^^, MaskBits, tRect, tRect, loc.h, loc.v, nil, 0); CopyBits(MaskBits, BitMapHandle(osPort^.PortPixMap)^^, tRect, tRect, SrcOr, nil); DisposePtr(MaskBits.baseAddr); changes := true; end; {with} SetPort(tPort); SetGDevice(SaveGDevice); UpdatePicWindow; WhatToUndo := UndoEdit; end; procedure SetSprayCanSize; var TempSize: integer; Canceled: boolean; begin TempSize := GetInt('Spray can diameter in pixels(2-250):', SprayCanDiameter, Canceled); if Canceled then exit(SetSprayCanSize); if (TempSize > 1) and (TempSize <= 250) then begin SprayCanDiameter := TempSize; SprayCanRadius := SprayCanDiameter div 2; SprayCanRadius2 := SprayCanRadius * SprayCanRadius end else beep; end; procedure SetBrushSize; var TempSize: integer; Canceled: boolean; i, ticks, x, y: LongInt; v: integer; begin TempSize := GetInt('Brush Size in pixels(1..99):', BrushWidth, Canceled); if Canceled then exit(SetBrushSize); if (TempSize > 0) and (TempSize < 100) then begin BrushWidth := TempSize; BrushHeight := BrushWidth end else beep; {exit(SetBrushSize);} {Timer} x := 100; y := 100; ticks := TickCount; for i := 1 to 1000000 do v := MyGetPixel(x, y); ShowMessage(concat('ticks=', long2str(TickCount - ticks))); end; procedure SetLineWidth; var TempSize: integer; Canceled: boolean; begin TempSize := GetInt('Line Width in pixels(1..100):', LineWidth, Canceled); if Canceled then exit(SetLineWidth); if (TempSize > 0) and (TempSize <= 100) then begin LineWidth := TempSize; ShowLineWidth; end else beep; end; procedure FindWhatToCopy; var kind: integer; WhichWindow: WindowPtr; begin WhatToCopy := NothingToCopy; WhichWindow := FrontWindow; if WhichWindow = nil then exit(FindWhatToCopy); kind := WindowPeek(WhichWindow)^.WindowKind; if (CurrentTool = PickerTool) and (kind <> TextKind) then WhatToCopy := CopyColor else begin if (kind = PicKind) and measuring and (not macro) then kind := ResultsKind; case kind of PicKind: with info^, info^.RoiRect do if RoiShowing and (left >= 0) and (top >= 0) and (right <= PicRect.right) and (bottom <= PicRect.bottom) then WhatToCopy := CopySelection; HistoKind: WhatToCopy := CopyHistogram; ProfilePlotKind: WhatToCopy := CopyPlot; CalibrationPlotKind: WhatToCopy := CopyCalibrationPlot; LUTKind: if info <> NoInfo then WhatToCopy := CopyCLUT; MapKind: if info <> NoInfo then WhatToCopy := CopyGrayMap; ToolKind: WhatToCopy := CopyTools; TextKind: begin TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); if TextInfo <> nil then with TextInfo^.TextTE^^ do if selEnd > selStart then WhatToCopy := CopyText; end; InfoKind, ResultsKind: if mCount > 0 then WhatToCopy := CopyMeasurements; otherwise end; end; end; procedure UpdateEditMenu; var DimUndo, ShowItems: boolean; str: str255; i: integer; begin with info^ do begin if CurrentKind < 0 then begin {DA is active, so activate Edit menu.} SetMenuItemText(EditMenuH, UndoItem, 'Undo'); SetMenuItemText(EditMenuH, CutItem, 'Cut'); SetMenuItemText(EditMenuH, CopyItem, 'Copy'); SetMenuItem(EditMenuH, UndoItem, true); for i := CutItem to ClearItem do SetMenuItem(EditMenuH, i, true); exit(UpdateEditMenu); end; if not (WhatToUndo in [UndoLUT, UndoMeasurement, UndoPoint]) and ((info = NoInfo) or (PixMapSize <> CurrentUndoSize)) then WhatToUndo := NothingToUndo; DimUndo := WhatToUndo = NothingToUndo; SetMenuItem(EditMenuH, UndoItem, not DimUndo); if DimUndo then SetMenuItemText(EditMenuH, UndoItem, 'Undo'); case WhatToUndo of UndoEdit: str := 'Editing'; UndoFlip: str := 'Flip'; UndoRotate: str := 'Rotate'; UndoFilter: str := 'Filtering'; UndoPaste: str := 'Paste'; UndoMeasurement, UndoPoint: str := 'Measurement'; UndoTransform: str := 'Transformation'; UndoClear: str := 'Clear'; UndoZoom: str := 'Zoom'; UndoOutline: str := 'Outline'; UndoSliceDelete, UndoFirstSliceDelete: str := 'Delete Slice'; UndoLUT: str := 'LUT Change'; otherwise str := ''; end; SetMenuItemText(EditMenuH, UndoItem, concat('Undo ', str)); FindWhatToCopy; if WhatToCopy = CopySelection then str := 'Cut Selection' else str := 'Cut'; SetMenuItemText(EditMenuH, CutItem, str); SetMenuItem(EditMenuH, CutItem, (WhatToCopy = CopySelection) or (WhatToCopy = CopyText)); case WhatToCopy of NothingToCopy, CopyText: str := ''; CopySelection: str := 'Selection'; CopyCLUT: str := 'LUT'; CopyGrayMap: str := 'Gray Map'; CopyTools: str := 'Tools'; CopyPlot: str := 'Plot'; CopyCalibrationPlot: str := 'Calibration Plot'; CopyHistogram: str := 'Histogram'; CopyMeasurements: str := 'Measurements'; CopyColor: str := 'Color'; end; SetMenuItemText(EditMenuH, CopyItem, concat('Copy ', str)); SetMenuItem(EditMenuH, CopyItem, WhatToCopy <> NothingToCopy); SetMenuItem(EditMenuH, ClearItem, (WhatToCopy = CopySelection) or (WhatToCopy = CopyText)); ShowItems := (WhatsOnClip <> NothingOnClip) or (OldScrapCount <> GetScrapCount); SetMenuItem(EditMenuH, PasteItem, ShowItems); SetMenuItem(EditMenuH, ShowClipboardItem, ShowItems); ShowItems := info <> NoInfo; if CurrentKind = TextKind then SetMenuItemText(EditMenuH, FillItem, 'Find…') else SetMenuItemText(EditMenuH, FillItem, 'Fill'); SetMenuItem(EditMenuH, FillItem, ShowItems or (CurrentKind = TextKind)); SetMenuItem(EditMenuH, InvertItem, ShowItems); SetMenuItem(EditMenuH, DrawBoundaryItem, ShowItems); SetMenuItem(EditMenuH, DrawScaleItem, ShowItems); if (RoiShowing and EqualRect(RoiRect, PicRect)) and (CurrentKind <> TextKind) then SetMenuItemText(EditMenuH, SelectAllItem, 'Deselect All') else SetMenuItemText(EditMenuH, SelectAllItem, 'Select All'); SetMenuItem(EditMenuH, SelectAllItem, ShowItems or (CurrentKind = TextKind)); SetMenuItem(EditMenuH, DeselectItem, ShowItems and RoiShowing); SetMenuItem(EditMenuH, ScaleAndRotateItem, ShowItems); for i := RotateLeftItem to FlipHorizontalItem do SetMenuItem(EditMenuH, i, ShowItems); SetMenuItem(EditMenuH, UnZoomItem, ShowItems and ((magnification <> 1.0) or ScaleToFitWindow)); end; {with} end; procedure ZoomOut; var Width, Height, divisor, NewWidth, NewHeight: integer; OldMagnification, xratio, yratio: extended; begin with Info^ do begin if magnification < 2.0 then begin beep; exit(ZoomOut) end; OldMagnification := magnification; if magnification = 2.0 then begin magnification := 1.0; divisor := 4 end else if magnification = 3.0 then begin magnification := 2.0; divisor := 6 end else if magnification = 4.0 then begin magnification := 3.0; divisor := 8 end else begin magnification := magnification / 2.0; divisor := 4 end; if EqualRect(SrcRect, PicRect) then begin {Make window smaller} NewWidth := trunc(PicRect.right * magnification); NewHeight := trunc(PicRect.bottom * magnification); SizeWindow(wptr, NewWidth, NewHeight, true); wrect.right := NewWidth; wrect.bottom := NewHeight; SrcRect := PicRect; UpdateTitleBar; UpdatePicWindow; DrawMyGrowIcon(wptr); exit(ZoomOut); end; if ((wrect.right > PicRect.right) or (wrect.bottom > PicRect.bottom)) then begin xratio := wrect.right / PicRect.right; yratio := wrect.bottom / PicRect.bottom; if (xratio <> yratio) or ((xratio - trunc(xratio)) <> 0.0) then begin UnZoom; Exit(ZoomOut) end; SrcRect := PicRect; Magnification := xratio; UpdateTitleBar; UpdatePicWindow; DrawMyGrowIcon(wptr); Exit(ZoomOut) end; end; {with} with Info^.SrcRect, info^ do begin if magnification = 1.0 then begin width := wrect.right; height := wrect.bottom; end else begin width := round((right - left) * OldMagnification / Magnification); height := round((bottom - top) * OldMagnification / Magnification); end; left := left - (width div divisor); if left < 0 then left := 0; if (left + width) > Info^.PicRect.right then left := Info^.PicRect.right - width; top := top - (height div divisor); if top < 0 then top := 0; if (top + height) > Info^.PicRect.bottom then top := Info^.picRect.bottom - height; right := left + width; bottom := top + height; RoiShowing := false; UpdatePicWindow; DrawMyGrowIcon(wptr); UpdateTitleBar; end; ShowRoi; end; procedure DoGrow; {(WhichWindow: WindowPtr; event: EventRecord)} var NewSize: LongInt; trect, WinRect, SizeRect: rect; kind: integer; WasDigitizing: boolean; ZoomCenterH, ZoomCenterV, width, height: extended; begin kind := WindowPeek(WhichWindow)^.WindowKind; if kind = PicKind then with info^, SizeRect do begin if ScaleToFitWindow then SizeRect := qd.ScreenBits.bounds else begin right := PicRect.right + 1; bottom := PicRect.bottom + 1; if magnification > 1.0 then begin right := round(right * magnification); bottom := round(bottom * magnification); end; left := 32; top := 32; if left > right then left := right; if top > bottom then top := bottom; end end else SetRect(SizeRect, 64, 48, 2048, 2048); NewSize := GrowWindow(WhichWindow, event.where, SizeRect); if newSize = 0 then exit(DoGrow); if kind = PicKind then with Info^ do begin SetPort(wptr); WasDigitizing := digitizing; StopDigitizing; InvalRect(wrect); with trect do begin top := 0; left := 0; right := LoWrd(NewSize); bottom := HiWrd(NewSize); end; if ScaleToFitWindow then begin ScaleImageWindow(trect); wrect := trect; end else begin if trect.right > PicRect.right * magnification then trect.right := trunc(PicRect.right * magnification); if trect.bottom > PicRect.bottom * magnification then trect.bottom := trunc(PicRect.bottom * magnification); wrect := trect; with SrcRect do begin ZoomCenterH := left + (wrect.right / 2.0) / magnification; ZoomCenterV := top + (wrect.bottom / 2.0) / magnification; width := wrect.right / magnification; height := wrect.bottom / magnification; left := round(ZoomCenterH - width / 2.0); if left < 0 then left := 0; if (left + width) > PicRect.right then left := round(PicRect.right - width); top := round(ZoomCenterV - height / 2.0); if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := round(picRect.bottom - height); right := round(left + width); bottom := round(top + height); wrect.right := trunc((right - left) * magnification); wrect.bottom := trunc((bottom - top) * magnification); end; savewrect := wrect; end; SizeWindow(WhichWindow, wrect.right, wrect.bottom, true); WindowState := NormalWindow; if WasDigitizing then StartDigitizing; exit(DoGrow) end; {with info^} if WhichWindow = PlotWindow then begin PlotWidth := LoWrd(NewSize); PlotHeight := HiWrd(NewSize); SetPort(PlotWindow); SizeWindow(PlotWindow, PlotWidth, Plotheight, true); InvalRect(PlotWindow^.PortRect); exit(DoGrow) end; if (kind = TextKind) then begin TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); GrowTextWindow(NewSize); exit(DoGrow) end; if WhichWindow = ResultsWindow then begin ResultsWidth := LoWrd(NewSize); ResultsHeight := HiWrd(NewSize); SetPort(ResultsWindow); with ResultsWindow^.PortRect do SetRect(tRect, right - 12, bottom - 12, right, bottom); EraseRect(trect); {Erase Grow Box} SizeWindow(ResultsWindow, ResultsWidth, ResultsHeight, true); MoveControl(hScrollBar, -1, ResultsHeight - ScrollBarWidth); MoveControl(vScrollBar, ResultsWidth - ScrollBarWidth, -1); SizeControl(hScrollBar, ResultsWidth - 13, ScrollBarWidth + 1); SizeControl(vScrollBar, ScrollBarWidth + 1, ResultsHeight - 13); InvalRect(ResultsWindow^.PortRect); with ListTE^^.viewRect do begin right := left + ResultsWidth - ScrollBarWidth - 4; bottom := top + ResultsHeight - ScrollBarWidth; end; UpdateResultsScrollBars; ScrollResultsText; end; end; procedure ZoomIn; {(event: EventRecord)} var width, height, OldMagnification: extended; PicCenterH, PicCenterV, NewWidth, NewHeight: integer; trect: rect; begin if Info = NoInfo then begin beep; exit(ZoomIn) end; if Info^.ScaleToFitWindow then begin PutError('The magnifying glass does not work in "Scale to Fit Window" mode.'); exit(ZoomIn) end; if BitAnd(Event.modifiers, OptionKey) = OptionKey then begin ZoomOut; WhatToUndo := NothingToUndo; exit(ZoomIn) end; with Info^ do begin OldMagnification := magnification; if magnification = 1.0 then magnification := 2.0 else if magnification = 2.0 then magnification := 3.0 else if magnification = 3.0 then magnification := 4.0 else begin magnification := magnification * 2.0; if magnification > 64.0 then begin magnification := 64.0; exit(ZoomIn) end; end; if (WindowState = NormalWindow) and EqualRect(SrcRect, PicRect) then {Make window bigger?} with trect do begin NewWidth := trunc(PicRect.right * magnification); NewHeight := trunc(PicRect.bottom * magnification); if NewWidth <= 640 then begin GetWindowRect(wptr, trect); if ((left + NewWidth) <= ScreenWidth) and ((top + NewHeight) <= ScreenHeight) then begin SizeWindow(wptr, NewWidth, NewHeight, true); wrect.right := NewWidth; wrect.bottom := NewHeight; end; end; end; end; {with} with Info^.SrcRect, Info^ do begin PicCenterH := left + round(event.where.h / OldMagnification); PicCenterV := top + round(event.where.v / OldMagnification); width := wrect.right / magnification; height := wrect.bottom / magnification; left := PicCenterH - round(width / 2.0); if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - round(width); top := PicCenterV - round(height / 2.0); if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := picRect.bottom - round(height); right := left + round(width); bottom := top + round(height); wrect.right := trunc((right - left) * magnification); wrect.bottom := trunc((bottom - top) * magnification); SizeWindow(wptr, wrect.right, wrect.bottom, true); RoiShowing := false; UpdatePicWindow; DrawMyGrowIcon(wptr); UpdateTitleBar; WhatToUndo := UndoZoom; ShowRoi; end; {with} end; procedure SynchScroll; var n: integer; TempInfo, SaveInfo: InfoPtr; begin SaveInfo := info; if allsamesize then for n := 1 to nPics do begin TempInfo := pointer(WindowPeek(PicWindow[n])^.RefCon); TempInfo^.SrcRect := info^.SrcRect; TempInfo^.magnification := Info^.magnification; info := TempInfo; UpdatePicWindow; Info := SaveInfo; end else PutError('Synchronized scrolling requires all images and all windows to be the same size.'); end; procedure Scroll; {(event: EventRecord)} var hstart, vstart, DeltaH, DeltaV, width, height: integer; loc: point; SaveSR: rect; WasDigitizing: boolean; begin with info^ do begin if ScaleToFitWindow then begin PutError('Scrolling does not work in "Scale to Fit Window" mode.'); exit(Scroll) end; WasDigitizing := digitizing; StopDigitizing; with event.where do begin hstart := h; vstart := v end; with SrcRect do begin width := right - left; height := bottom - top end; SaveSR := SrcRect; while StillDown do begin GetMouse(loc); DeltaH := hstart - loc.h; DeltaV := vstart - loc.v; with SrcRect do begin left := SaveSR.left + DeltaH; if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - width; right := left + width; top := SaveSR.top + DeltaV; if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := PicRect.bottom - height; bottom := top + height; end; UpdatePicWindow; DrawMyGrowIcon(wptr); end; WhatToUndo := NothingToUndo; ShowRoi; if OptionKeyDown and (nPics > 1) then SynchScroll; if WasDigitizing then StartDigitizing; end; {with info^} end; procedure ConverToSystemClipboard; {Converts local clipboard to system-wide clipboard} {when quitting or switching to other programs.} var PicH: PicHandle; err: LongInt; saveClipRgn: RgnHandle; begin PicH := nil; if ((WhatsOnClip = RectPic) or (WhatsOnClip = CameraPic)) and (ClipBuf <> nil) and not ClipboardConverted then with ClipBufInfo^ do begin ShowWatch; SetPort(GrafPtr(osPort)); saveClipRgn := NewRgn; GetClip(saveClipRgn); ClipRect(RoiRect); LoadLUT(ctable); {Switch to original LUT} RGBForeColor(BlackRGB); RGBBackColor(WhiteRGB); PicH := OpenPicture(RoiRect); with osPort^ do CopyBits(BitMapHandle(portPixMap)^^, BitMapHandle(portPixMap)^^, RoiRect, RoiRect, SrcCopy, nil); ClosePicture; if info <> NoInfo then LoadLUT(info^.ctable); {Restore LUT} if (PicH <> nil) or ClipTextInBuffer then begin err := ZeroScrap; if err = NoErr then begin if PicH <> nil then begin hlock(handle(PicH)); err := PutScrap(GetHandleSize(handle(PicH)), 'PICT', handle(PicH)^); hunlock(handle(PicH)); DisposeHandle(handle(PicH)); end; if (err = noErr) and ClipTextInBuffer then err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP)); end; {if err=NoErr} end; ClipboardConverted := true; SetClip(saveClipRgn); DisposeRgn(saveClipRgn); end; {with} end; procedure SetupOperation; {(item: integer)} var AutoSelectAll: boolean; begin if NotinBounds then exit(SetupOperation); if item = DrawBoundaryItem then if NoSelection then exit(SetupOperation); if item = InvertItem then if not CheckCalibration then exit(SetupOperation); StopDigitizing; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); SetupUndo; WhatToUndo := UndoEdit; case Item of FillItem: begin CurrentOp := PaintOp; OpPending := true end; InvertItem: begin CurrentOp := InvertOp; OpPending := true end; DrawBoundaryItem: begin CurrentOp := FrameOp; OpPending := true end; end; if AutoSelectAll then KillRoi; RoiUpdateTime := 0; {Forces outline to be redrawn in scale-to-fit mode.} end; procedure DoUndo; var aok: boolean; begin case WhatToUndo of UndoMeasurement: UndoLastMeasurement(true); UndoPoint: begin Undo; UpdatePicWindow; UndoLastMeasurement(true); WhatToUndo := NothingToUndo; end; UndoZoom: begin ZoomOut; if info^.magnification < 2 then WhatToUndo := NothingToUndo; end; UndoOutLine: begin undo; if WandAutoMeasure then UndoLastMeasurement(true); WhatToUndo := NothingToUndo; UpdatePicWindow; end; UndoSliceDelete, UndoFirstSliceDelete: if info^.StackInfo <> nil then with info^.StackInfo^ do begin if WhatToUndo = UndoFirstSliceDelete then CurrentSlice := 0; aok := AddSlice(false); if aok then begin Undo; UpdatePicWindow; end else if CurrentSlice = 0 then CurrentSlice := 1; end; UndoLUT: begin UndoLutChange; DrawMap; DensitySlicing := false; end; otherwise begin if UndoFromClip then OpPending := false; if not OpPending then undo; WhatToUndo := NothingToUndo; if IsInsertionPoint then begin InsertionPoint := TextStart; TextStr := ''; end; UpdatePicWindow; if OpPending and (CurrentOp = PasteOp) then begin OpPending := false; KillRoi; end; OpPending := false; end; end; {case} end; end. 
